home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 7
/
Apprentice-Release7.iso
/
Source Code
/
Pascal
/
Applications
/
DropBin 1.5
/
BinProgress.p
< prev
next >
Wrap
Text File
|
1997-04-16
|
9KB
|
364 lines
Unit BinProgress;
{$NR+}
Interface
Uses
Toolbox, DropBinUtils, Palettes;
Const
kDialogOKHit = 1;
kDialogCancelHit = 2;
Var
infoRect,
infoRect2,
statusRect,
countRect,
progressRect,
filledRect,
emptyRect: rect;
curAmount: longint;
totalAmount: longint;
dark,light: RGBColor;
backGround: RGBColor;
Procedure MakeDefaultButton(theButton: ControlHandle);
Procedure DisplayStatus;
Procedure ResetWindow(wp: WindowPtr);
Procedure SetupProgress;
Procedure DoProgressEvent(var theEvent: EventRecord; var keyPressed: integer);
Procedure StartProgress(len: longint);
Procedure EndProgress;
Procedure MakeColor(var col: RGBColor; red, green, blue: integer);
Function UpdateProgress(amt: longint): integer;
Implementation
Procedure MakeDefaultButton(theButton: ControlHandle);
Const
kButtonFrameInset = -4;
kButtonFrameSize = 3;
kCntrlActivate = 0;
Var
itemRect: Rect;
curPen: PenState;
buttonOval: Integer;
fgSaveColor: RGBColor;
bgColor: RGBColor;
newfgColor: RGBColor;
newGray: Boolean;
oldPort: WindowPtr;
isColor: Boolean;
begin
{ draw a bold border around default button }
GetPort(oldPort);
SetPort(theButton^^.contrlOwner);
GetPenState(curPen);
PenNormal;
itemRect := theButton^^.contrlRect;
InsetRect(itemRect, kButtonFrameInset, kButtonFrameInset);
FrameRoundRect(itemRect, 16, 16);
buttonOval := (itemRect.bottom - itemRect.top) DIV 2 + 2;
if true then
isColor := TRUE
else
isColor := FALSE;
if theButton^^.contrlHilite <> kCntrlActivate then
begin {control is dimmed, so draw default button outline}
newGray := FALSE;
if isColor then
begin
GetBackColor(bgColor);
GetForeColor(fgSaveColor);
newfgColor := fgSaveColor;
{use the gray defined by the current device}
newGray := GetGray(GetGDevice, bgColor, newfgColor);
end;
if newGray then
RGBForeColor(newfgColor)
else
PenPat(qd.gray);
PenSize(kButtonFrameSize, kButtonFrameSize);
FrameRoundRect(itemRect, buttonOval, buttonOval);
if isColor then
RGBForeColor(fgSaveColor);
end
else {control is active, so draw default button outline in black}
begin
PenPat(qd.black);
PenSize(kButtonFrameSize, kButtonFrameSize);
FrameRoundRect(itemRect, buttonOval, buttonOval);
end;
SetPenState(curPen);
SetPort(oldPort);
end; { of MakeDefaultButton }
Procedure DisplayProgress;
Var
str: str255;
r: rect;
w, uw: integer;
begin
SetPort(dbWindow);
case gStatType of
kShowRemaining: str := DBFormat(MaxValue(0,totalAmount - curAmount));
kShowProcessed: str := DBFormat(curAmount);
kShowTotal: str := DBFormat(totalAmount);
{case} end;
StringToRect(str, countRect, 9, []);
FrameRect(progressRect);
r := progressRect;
insetRect(r,1,1);
if totalAmount < 0 then
EraseRect(r)
else
begin
w := r.right - r.left;
if totalAmount <= 0 then
uw := 0
else if curAmount >= totalAmount then
uw := w
else
uw := FracMul(w, FracDiv(curAmount, totalAmount));
filledRect := r;
emptyRect := r;
filledRect.right := r.left + uw;
emptyRect.left := r.left + uw;
RGBForeColor(dark);
RGBBackColor(light);
PaintRect(filledRect);
RGBForeColor(light);
RGBBackColor(dark);
PaintRect(emptyRect);
ForeColor(blackColor);
RGBBackColor(backGround);
end;
end; { of DisplayProgress }
Procedure DisplayStatus;
Var
str: str255;
begin
StringToRect('Encoding: ', infoRect, 9, [bold]);
AppendToRect(gFilename);
StringToRect('Output file: ', infoRect2, 9, [bold]);
AppendToRect(gOutputName);
if gStatType = kShowRemaining then
str := 'Remaining: '
else if gStatType = kShowProcessed then
str := 'Processed: '
else
str := 'Total: ';
StringToRect(str, statusRect, 9, [bold]);
countRect := statusRect;
countRect.left := countRect.left + StringWidth(str);
DisplayProgress;
end; { of DisplayStatus }
Procedure ResetWindow(wp: WindowPtr);
begin
if (wp <> dbWindow) or ((not gOApped) and (not gProcessing)) then
exit(ResetWindow);
SetPort(wp);
BeginUpdate(wp);
if gProcessing then
begin
EraseRect(wp^.portRect);
DisplayStatus;
DrawControls(wp);
end
else
begin
EraseRect(wp^.portRect);
DrawControls(wp);
MakeDefaultButton(encodeButton);
StringToRect('Ready to encode a file.', infoRect, 0, []);
end;
EndUpdate(wp);
end;
Procedure SetupProgress;
begin
if dbWindow = NIL then
begin
setRect(infoRect, 10, 10, 250, 30);
setRect(infoRect2, 10, 35, 250, 55);
setRect(statusRect, 10, 60, 250, 80);
setRect(progressRect, 10, 85, 250, 97);
MakeColor(dark, $4000, $4000, $4000);
MakeColor(light, $CCCC, $CCCC, $FFFF);
dbWindow := GetNewCWindow(128, NIL, Pointer(-1));
if gOApped then
begin
encodeButton := GetNewControl(128, dbWindow);
MoveControl(encodeButton, 50, 95);
MakeDefaultButton(encodeButton);
quitButton := GetNewControl(129, dbWindow);
MoveControl(quitButton, 150, 95);
ShowControl(encodeButton);
ShowControl(quitButton);
end;
cancelButton := GetNewControl(130, dbWindow);
MoveControl(cancelButton, progressRect.right + 10, progressRect.top - 5);
if dbWindow <> NIL then
begin
ShowWindow(dbWindow);
SetPort(dbWindow);
GetBackColor(backGround);
ResetWindow(dbWindow);
end;
end
else
begin
ForeColor(blackColor);
RGBBackColor(backGround);
end;
end;
Procedure DoProgressEvent(var theEvent: EventRecord; var keyPressed: integer);
Var
theWindow: WindowPtr;
aRect: Rect;
thePart: integer;
keyCode: integer;
control: ControlRef;
finalTicks: longint;
begin
keyPressed := 0;
case theEvent.what of
mouseDown: begin
thePart := FindWindow(theEvent.where, theWindow);
case thePart of
inDrag: if theWindow = dbWindow then
begin
aRect := qd.screenBits.bounds;
InsetRect(aRect, -4, -4);
DragWindow(theWindow, theEvent.where, aRect);
end;
inContent: if theWindow = dbWindow then
begin
SetPort(dbWindow);
GlobalToLocal(theEvent.where);
if FindControl(theEvent.where, dbWindow,
control) > 0 then
begin
if TrackControl(control,
theEvent.where, nil) > 0 then
if control = cancelButton then
keyPressed := kDialogCancelHit;
end
else if PtInRect(theEvent.where, statusRect) then
begin
gStatType := (gStatType + 1) mod 3;
InvalRect(dbWindow^.portRect);
end;
end;
inMenuBar: MenuSelect(theEvent.where);
{CASE} end;
end;
keyDown,
autokey: if FrontWindow = dbWindow then
begin
keyCode := BAnd(theEvent.message, charCodeMask);
if (keyCode = kEscapeKey) or ((keyCode = integer('.')) and
(BAnd(theEvent.modifiers,cmdKey) = cmdKey)) then
begin
HiliteControl(cancelButton, kControlButtonPart);
Delay(8, finalTicks); {invert button for 8 ticks}
HiliteControl(cancelButton, 0);
keyPressed := kDialogCancelHit;
end;
end;
osEvt: if BAnd(brotl(theEvent.message,8),$FF) = suspendResumeMessage then
begin
gBackground := BAnd(theEvent.message,resumeFlag) = 0;
if gBackground then
HiliteControl(cancelButton, 255)
else
HiliteControl(cancelButton, 0);
end;
updateEvt: begin
InvalRect(WindowPtr(theEvent.message)^.portRect);
ResetWindow(WindowPtr(theEvent.message));
end;
{CASE} end;
end; { of DoProgressEvent }
Procedure StartProgress(len: longint);
Var
theRect: rect;
begin
totalAmount := len;
curAmount := 0;
SetPort(dbWindow);
EraseRect(progressRect);
ShowControl(cancelButton);
DisplayStatus;
theRect := encodeButton^^.contrlRect;
InsetRect(theRect,-16,-16);
EraseRect(theRect);
if gOApped then
begin
HideControl(quitButton);
HideControl(encodeButton);
end;
DisableItem(gAppleMenu,0);
DisableItem(gFileMenu,0);
end;
Procedure EndProgress;
begin
SetPort(dbWindow);
EnableItem(gAppleMenu,0);
EnableItem(gFileMenu,0);
HideControl(cancelButton);
if gOApped then
begin
ShowControl(quitButton);
ShowControl(encodeButton);
end;
DrawMenuBar;
end;
Procedure MakeColor(var col: RGBColor; red, green, blue: integer);
begin
col.red := red;
col.green := green;
col.blue := blue;
end;
Function UpdateProgress(amt: longint): integer;
Var
theEvent: EventRecord;
keyPressed: integer;
begin
keyPressed := 0;
curAmount := curAmount + amt;
if GetNextEvent(everyEvent, theEvent) then
DoProgressEvent(theEvent, keyPressed);
UpdateProgress := keyPressed;
if keyPressed = kDialogCancelHit then { if interrupt, then exit }
exit(UpdateProgress);
DisplayProgress;
end;
End.